112

Beginner’s Guide to Code Algorithms

112

STEP 3 & 4—​draw arrow function continued 3

        MyRct.TextFrame2.TextRange.Characters.Text =​ i & “.” &

Sheets(CurrentSheetName).Cells(i, 3).Value

        MyRct.TextFrame2.TextRange.Characters.Font.Size =​ 6

        MyRct.TextFrame2.VerticalAnchor =​ msoAnchorBottom

        MyRct.TextFrame2.TextRange.ParagraphFormat.Alignment =​ msoAlignLeft

        MyRct.TextFrame2.TextRange.Characters.Font.Fill.ForeColor.

RGB =​ RGB(255, 0, 0)

        MyRct.TextFrame2.AutoSize =​ msoAutoSizeShapeToFitText

      End With

    End If

  Else

  If ShapeExists(Label) Then

    Selection.ShapeRange.TextFrame2.TextRange.Characters.Text =​ Selection.

ShapeRange.TextFrame2.TextRange.Characters.Text & Chr(10) & i & “.” &

Sheets(CurrentSheetName).Cells(i, 3).Value

      For kk =​ 1 To LabelObjectNumber

        If LabelObject(kk) =​ Label Then

        LinesInLabel(kk) =​ LinesInLabel(kk) +​ 1

      End If

    Next

  Else

    LabelObjectNumber =​ LabelObjectNumber +​ 1

    LinesInLabel(LabelObjectNumber) =​ 1

    LabelObject(LabelObjectNumber) =​ Label

    Set rng =​ Range(Cells(LabelRow, LabelCol), Cells(LabelRow +​ 2, LabelCol +​ 1))

    With rng

      Set MyRct =​ ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal,

.Left, .Top, .Width, .Height)

      MyRct.Name =​ Sheets(CurrentSheetName).Cells(i, 1).Value & “-​1”

      MyRct.TextFrame2.TextRange.Characters.Text =​ i & “.” &

Sheets(CurrentSheetName).Cells(i, 3).Value

      MyRct.TextFrame2.TextRange.Characters.Font.Size =​ 6

      MyRct.TextFrame2.VerticalAnchor =​ msoAnchorBottom

      MyRct.TextFrame2.TextRange.ParagraphFormat.Alignment =​ msoAlignLeft

      MyRct.TextFrame2.TextRange.Characters.Font.Fill.ForeColor.

RGB =​ RGB(255, 0, 0)

      MyRct.TextFrame2.AutoSize =​ msoAutoSizeShapeToFitText

    End With

  End If

End If

  If FoundPair =​ 0 Then

    Pair(i) =​ Sheets(CurrentSheetName).Cells(i, 1).Value &

Sheets(CurrentSheetName).Cells(i, 2).Value

  Else

    j =​ Worksheets(“IdenticalPairs”).Cells(Rows.Count, 1).End(xlUp).Row +​ 1

  Worksheets(“IdenticalPairs”).Cells(j, 1).Value =​ Sheets(CurrentSheetName).Cells(i,

1).Value

    Worksheets(“IdenticalPairs”).Cells(j, 2).Value =​ Sheets(CurrentSheetName).

Cells(i, 2).Value